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-- Store. mesa, modified by Sweet, August 2, 1978 11:10 AM 

DIRECTORY 

AltoDefs: FROM "altodefs" USING [Address, BYTE, charlength, wordlength], 

Code: FROM "code" USING [acstack, CodeNotlmplemented , CodePassInconsistancy , curctxlvl, fileindex, xt 
**racting, xtractlex, xtractsei], 

CodeDefs: FROM "codedefs" USING [BDOIndex, BDONull , ChunkBase, FullBitAddress, Lexeme, 1T0S, MaxParms 
**InStack, RegisterName, topostack], 

ComData: FROM "comdata" USING [tCO], 

FOpCodes: FROM "fopcodes" USING [qADD, qBLT, qBLTL, qDUP, qFREE, qGADRB , qLADRB, qLI , qLP, qPOP, qPS, 
** qPSD, qPSF, qPUSH, qRD, qRDL, qSL, qW, qWD, qWDL, qWL, qWR, qWS , qWSD, qWSF, qWSTR, qWSTRL], 

InlineDefs: FROM " inl inedef s" USING [BITSHIFT, DIVMOD], 

LitDefs: FROM "litdefs" USING [LTIndex, Ittype, MasterString , MSTIndex, sttype], 

P5ADefs: FROM "p5adefs" USING [addfulladdrtobits , bitsforoperand, bitsfortype, CioutO, Cioutl, Ciout2 
**, Cload, copyBDOItem, Cstore, Csyscall, dumpstack, FieldParam, freetempsei, genstringbodylex, gentemp 
**lex, loadaddress, loadlexaddress , loadseiaddress, loadtsonaddress, LogHeapFree, makeBDOItem, makeretl 
**ex, maketempaddrBDOItem, makeTOSlex, maketreel iteral , maketsonBDOItem, markstack, nextvar, operandtyp 
**e, P5Error, prewar, pushcomponent , releaseBDOItem, RequireStack, rmakeBDOItem, treel iteral value, wor 
**dsforoperand , wordsforsei], 

P5BDefs: FROM "p5bdefs" USING [Cexp, movetocodeword, MWConstant, pushlex, pushlitval, pushlnonnestedp 
**rocdesc, pushlprocdesc, pushrhs, writecodeword] , 

P5StmtExprDefs: FROM "p5stmtexprdef s" , 

SDDefs: FROM "sddefs" USING [sStringlnit], 

SymDefs: FROM "symdefs" USING [BitAddress, bodytype, BTIndex, CBTIndex, ContextLevel , CSEIndex, CTXIn 
**dex, ctxtype, HTIndex, ISEIndex, ISENull , 1G, 1Z, recordCSEIndex, SEIndex, setype, TypeClass], 

SymTabDefs: FROM "symtabdef s" USING [BitsForType, Cardinality, ContextVariant , FnField, NextSe, Recor 
**dRoot, TypeLink, TypeRoot, UnderType, WordsForType] , 

TableDefs: FROM "tabledefs" USING [TableBase, TableNotif ier] , 

TreeDefs: FROM "treedefs" USING [empty, listhead, nullTreelndex , reversescanl ist , scanlist, testtree, 
** Treelndex, TreeLink, treetype]; 

DEFINITIONS FROM CodeDefs; 

Store: PROGRAM 

IMPORTS MPtr: ComData, CPtr: Code, LitDefs, P5ADefs, P5BDefs, SymTabDefs, TreeDefs 

EXPORTS CodeDefs, P5ADefs, P5StmtExprDef s 

SHARES LitDefs » 
BEGIN 
OPEN SymTabDefs, P5ADefs, P5BDefs; 

-- imported definitions 

Address: TYPE = Al toDefs .Address; 

BYTE: TYPE = AltoDefs .BYTE ; 

wordlength: CARDINAL = AltoDefs. wordlength; 

charlength: CARDINAL = AltoDefs. charlength; 

BitAddress: TYPE = SymDefs .BitAddress; 

BTIndex: TYPE - SymDefs .BTIndex; 

CBTIndex: TYPE = SymDefs .CBTIndex ; 

ContextLevel: TYPE * SymDefs .ContextLevel ; 

CSEIndex: TYPE = SymDefs .CSEIndex; 

CTXIndex: TYPE = SymDefs .CTXIndex; 

HTIndex: TYPE <= SymDefs .HTIndex; 

ISEIndex: TYPE - SymDefs . ISEIndex; 

ISENull: ISEIndex ■ SymDefs . ISENul 1 ; 

1Z: ContextLevel - SymDefs. 1Z; 

1G: ContextLevel » SymDefs. 1G; 

recordCSEIndex: TYPE = SymDefs. recordCSEIndex; 

SEIndex: TYPE = SymDefs. SEIndex; 

TypeClass: TYPE * SymDef s.TypeCl ass ; 

MSTIndex: TYPE - LitDefs .MSTIndex; 

empty: TreeLink * TreeDefs. empty ; 
Treelndex: TYPE * TreeDefs . Treelndex; 
TreeLink: TYPE ■ TreeDefs. TreeLink; 

tb: TableDefs. TableBase; -- tree base (local copy) 

seb: TableDefs. TableBase; -- semantic entry base (local copy) 

ctxb: Tab leDefs. TableBase; -- context entry base (local copy) 

bb: TableDefs. TableBase; -- body entry base (local copy) 

cb: ChunkBase; -- code base (local copy) 

stb: TableDefs. TableBase; -- string base (local copy) 

Kb: TableDefs. TableBase; -- literal base (local copy) 
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StoreNotify: PUBLIC TableDef s .TableNotif ier ■ 

BEGIN -- called by allocator whenever table area is repacked 

seb <- base[SymDefs.setype]; 

ctxb «- base[SymDef s.ctxtype] ; 

bb <- base[SymDef s .bodytype] ; 

stb <- base[LitDefs,sttype]; 

tb «- base[TreeDef s . treetype]; 

cb <- L00PH0LE[tb]; 

Itb «- base[LitDefs.lttype]; 

RETURN 

END; 

-- state data and code for construction 

DUPcount: CARDINAL; 

AddressOnStack, BuildinglnStack: BOOLEAN; 

ConstructionState: TYPE ■ RECORD[ 
savDUPcount: CARDINAL, 
savAddressOnStack, savBuildinglnStack: BOOLEAN]; 

ConstructionError: SIGNAL » CODE; 

SaveConstructionState: PROCEDURE [p: POINTER TO ConstructionState] - 
BEGIN 

pt +■ ConstructionState[DUPcount, AddressOnStack, BuildinglnStack]; 
RETURN 
END; 

RestoreConstructionState: PROCEDURE [p: POINTER TO ConstructionState] - 
BEGIN 

[DUPcount, AddressOnStack, BuildinglnStack] «- pt; 
RETURN 
END; 

InitConstructState: PROCEDURE [node: Treelndex] ■ 
BEGIN 

DUPcount <- 0; AddressOnStack <- BuildinglnStack «- FALSE; 
IF ( (tb+node) .name ■ rowcons OR (tb+node) .name ■ rowconsx) 
AND (tb+node). attrl THEN 
BEGIN DUPcount «- 1; RETURN END; 
TreeDef s . scanl ist[( tb+node) . son 2, countDUPs]; 
RETURN 
END; 

countDUPs: PROCEDURE [t: TreeLink] » 
BEGIN 
node: Treelndex; 

IF t - empty THEN RETURN; 
WITH t SELECT FROM 
subtree => 
BEGIN 

node <- index; 

SELECT (tb+node). name FROM 
rowconsx, constructx «> 

WITH ( tb+node). sonl SELECT FROM 
subtree ■> 

IF ( tb+index) .name a temp 
AND ~((tb+node) .name ■ rowconsx AND (tb+node) .attrl) THEN 
BEGIN TreeDefs.scanlist[(tb+node).son2, countDUPs]; RETURN END; 
ENDCASE; 
unionx *> 
BEGIN 

IF ( tb+node). attr2 THEN DUPcount <- DUPcount+1; 
TreeDefs. scanl is t[( tb+node) .son2, countDUPs]; 
RETURN 
END; 
cast, align »> BEGIN TreeDef s. scanl ist[( tb+node) .sonl , countDUPs]; RETURN END; 
ENDCASE; 
END; 
ENDCASE; 
DUPcount <- DUPcount+1; 
RETURN 
END; 
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ConstructCountDown: PROCEDURE ■ 
BEGIN 
IF L00PH0LE[(DUPcount <- DUPcount-1) , INTEGER] < THEN 

SIGNAL ConstructionError ; 
RETURN 
END; 



Crowcons: PUBLIC PROCEDURE [node: Treelndex] ■ 
BEGIN -- array initialization 
r: BDOIndex; 
asize: CARDINAL; 

InitConstructState[node]; 

IF DUPcount » THEN RETURN; 

r <- maketsonBDOItem[(tb+node) .sonl]. lexbdoi; 

asize *- cb[r]. off set. size; 

IF ~easilyaddressed[r] THEN 

BEGIN 

IF loadaddress[copyBDOItem[r]] # wordlength THEN 
SIGNAL CPtr.CodeNotlmplemented; 

addrtostack[r]; 

AddressOnStack «- TRUE; 

END; 
Carrayini t[r, node, operandtype[(tb+node) .sonl]]; 
IF DUPcount # THEN SIGNAL ConstructionError; 
RETURN 
END; 



Crowconsx: PUBLIC PROCEDURE [node: Treelndex] RETURNS[bdo Lexeme] 
BEGIN -- array (expression) initial ization 
r: BDOIndex; 

asei: CSEIndex <- ( tb+node) . info; 
awords: CARDINAL <- WordsForType[asei] ; 
savCS: ConstructionState; 

SaveConstructionState[@savCS]; 

InitConstructState[node]; 

r <- maketsonBDOItem[(tb+node) .sonl] . lexbdoi ; 

IF ~easilyaddressed[r] THEN 

BEGIN 

IF loadaddress[copyBDOItem[r]] ft wordlength THEN 
SIGNAL CPtr.CodeNotlmplemented; 

addrtostack[r]; 

AddressOnStack <- TRUE; 

END; 
DUPcount <- DUPcount+1; 

IF DUPcount # 1 THEN Carrayini t[copyBDOItem[r ] , node, asei]; 
IF DUPcount # 1 THEN SIGNAL ConstructionError; 
cb[r] .off set .size <- awords*wordlength; 
Res toreCons true tionState[@savCS] ; 
RETURN[Lexeme[bdo[r]]] 
END; 



Carrayinit: PROCEDURE [r: BDOIndex, node: Treelndex, asei: CSEIndex] 
BEGIN 

-- called for ARRAY initialization by rowcons and rowconsx 
w: CARDINAL; 
Crow[r, node, asei 

lPutAddressOnStack => RESUME; 
GetFloorWD => 
BEGIN 
IF loadaddress[copyBDOItem[r]] # wordlength THEN 

SIGNAL CPtr.CodeNotlmplemented; 
w <- cb[r] .offset. posn.wd; 
addrtostack[r]; 
RESUME[w] 
END]; 
RETURN 
END; 



Crow: PROCEDURE [r: BDOIndex, node: Treelndex, asei: CSEIndex] 
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BEGIN 

-- handles ARRAY initialization 
n: CARDINAL; 
nbits: CARDINAL; 
csei: CSEIndex; 
c: Address; 

filled: BOOLEAN <- FALSE; 
localstrconst , globalstrconst: BOOLEAN; 
constrow: PROCEDURE [t: TreeLink] » 
BEGIN -- outputs a row of constants 
scr: PROCEDURE [t: TreeLink] - 
BEGIN 

msti: MSTIndex; 
WITH e:t SELECT FROM 
literal «> 

WITH e.info SELECT FROM 
string ■> 
BEGIN 

msti «- LitDefs.MasterString[index]; 
IF (stb+msti) .local THEN localstrconst «- TRUE 
ELSE globalstrconst «- TRUE; 
writecodeword[( stb+msti) .info]; 
END; 
ENDCASE ■> P5ADefs.P5Error[577]; 
ENDCASE => P5ADefs.P5Error[578]; 
n <- n+1; 
RETURN 
END; 

n *- 0; 

TreeDefs. scanl ist[t, scr]; 

RETURN 

END; -- of constrow 

scrow: PROCEDURE [t: TreeLink] - 
BEGIN 

sr: BDOIndex; 
node: Treelndex; 

IF t # empty THEN IF BuildinglnStack THEN ERROR ELSE 
BEGIN 

sr «- copyBDOItem[r]; 
WITH t SELECT FROM 
subtree ■> 

SELECT (tb+index).name FROM 
align ■> 
BEGIN 

t «- (tb+index) .sonl; -- note the variant may change here 
cb[sr]. offset. size *- cb[sr] .off set . size - 

(bitsfortype[csei] - bi tsforoperand[t]) ; 
END; 
cast a > t «- (tb+index) . sonl; 
ENDCASE; 
ENDCASE; 
WITH t SELECT FROM 
subtree ■> 
BEGIN 

node <- index; 

SELECT (tb+node).name FROM 
rowconsx a > 

IF TreeDefs. testtree[( tb+node) .sonl, temp] THEN 
BEGIN 
Crow[sr, node, csei 

IPutAddressOnStack «> partialaddrtostack[sr .WDdecr]] ; 
cb[r] .off set .posn <- addfulladdrtobits[cb[r].off set.posn, nbits]; 
RETURN 
END; 
vconstructx, constructx *> 

IF TreeDefs . testtree[( tb+node) .sonl, temp] THEN 
BEGIN 

IF (tb+node). name - vconstructx THEN P5ADefs . P5Error[579] ; 
check a 1 ignment[sr , TypeRoot[csei]]; 
mainconstruct[sr , ( tb+node) . son2 , operandtype[t] , fieldaddress 

IPutAddressOnStack ■> par tial addrtostack[sr , WDdecr]]; 
cb[r]. off set.posn <- addfull addrtobits[cb[r]. of f set.posn, nbits]; 
RETURN 
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END; 
ENDCASE; 
END; 

ENDCASE; 
Cons true tCountDown[]; 

IF AddressOnStack THEN CRassign[sr, t, ISENul 1 , DUPcounttfO] 
ELSE 

BEGIN 

mwc: BOOLEAN «- FALSE; 

1 : Lexeme; 

1 <- Cexp[t ! MWConstant »> BEGIN mwc ♦• TRUE; RESUME[[bdo[sr]]] END]; 

IF mwc THEN releaseBDOItem[sr] 

ELSE tllCassign[empty, [bdo[sr]] t 1, FALSE, nbits]; 

END; 
END; 

cb[r].off set.posn «- addfulladdrtobits[cb[r]. offset. posn, nbits]; 
RETURN 
END; -- of scrow 

w: CARDINAL; 
tlex: se Lexeme; 

IF (tb+node).attrl THEN 
BEGIN 

c «- movetocodeword[]; 
localstrconst «- globalstrconst *- FALSE; 
constrow[(tb+node) .son2]; 
ConstructCountDown[]; 
IF AddressOnStack THEN 
BEGIN 

tlex <- gentemplex[l]; 
sCassign[tlex.lexsei]; 
END; 
dumpstack[]; markstack[]; 
push! itval[c]; 
push! itval[n]; 

IF localstrconst AND globalstrconst THEN SIGNAL CPtr .CodeNotlmplemented ; 
Cioutl[IF localstrconst THEN FOpCodes .qLADRB ELSE FOpCodes . qGADRB.O] ; 
IF AddressOnStack THEN pushlex[tlex] ; -- since r thinks it is already there 
IF loadaddress[r] # wordlength THEN 

SIGNAL CPtr. CodeNotlmplemented; 
Csyscall[SDDefs.sStringInit]; 

IF AddressOnStack AND DUPcount # THEN pushl ex[tlex]; 
RETURN 
END; 
WITH (seb+asei) SELECT FROM 
array a > 
BEGIN 

csei «- UnderType[componenttype]; 

IF packed AND SymTabDef s .BitsForType[componenttype] <* 8 THEN 
BEGIN 

nbits <- charlength; 
w ♦- SIGNAL GetFloorWD; 
SIGNAL PutAddressOnStack[w]; 
AddressOnStack <- TRUE; 
IF Cardinal ity[UnderType[indextype]] MOD 2 # THEN 

BEGIN DUPcount <~ DUPcount+1; filled <- TRUE END; 
END 
ELSE nbits <- wordsforsei[csei]*wordlength; 
END; 
ENDCASE => P5ADefs.P5Error[580]; 
cb[r] .off set. size <- nbits; 
TreeDefs . scanl ist[( tb+node) . son 2, scrow]; 
IF filled THEN scrow[MPtr . tCO] ; 
releaseBDOItem[r]; 
RETURN 
END; 

CRassign: PUBLIC PROCEDURE [r: BDOIndex, t: TreeLink, sei: ISEIndex, usePut: BOOLEAN] « 
BEGIN -- does a reverse-store for contructors 
OPEN FOpCodes; 
tlex: se Lexeme; 
s, v: CARDINAL; 
mwconst: BOOLEAN <- FALSE; 
1 : Lexeme; 



Store. mesa 2-Sep-78 12:59:59 Page 



IF cb[r].tag # bo OR cb[r]. base. size # wordlength THEN 

SIGNAL CP tr.CodePas si neons istancy; 
v <- cb[r] .offset. posn.wd; s *- cb[r] .off set. size; 
IF cb[r]. base. level # 1T0S THEN 
BEGIN 

pushcomponent[basecomponent,r]; 
END; 
IF s > wordlength*2 THEN 
BEGIN 

psize: CARDINAL; 
cb[r]. off set. posn.wd <- 0; 
[] <- loadaddress[r]; 
tlex «- gentemplex[l]; 
sCassign[tlex. lexsei]; 
RequireStack[0]; 
IF t # empty THEN 
BEGIN 

1 <- Cexp[t 
IMWConstant «> 
BEGIN 

r <- maketempaddrBDOItem[tlex]; 
cb[r] .off set .posn.wd «- v; 
mwconst «- TRUE; 
RESUME[ Lexeme[bdo[r]]]; 
END]; 
IF mwconst THEN GO TO stored; 
psize «- loadlexaddress[l ]; 
END 
ELSE psize <- loadseiaddress[sei]; 
push! i tval[s/wordlength]; 
pushlex[tlex] ; 

IF v # THEN BEGIN pushl i tval [v] ; CioutO[qADD] END; 
IF psize > wordlength THEN 

BEGIN CioutO[qLP]; CioutO[qBLTL] END 
ELSE CioutO[qBLT]; 
GO TO stored; 
EXITS 

stored »> BEGIN IF usePut THEN pushlex[tlex]; RETURN END; 
END; 
IF t # empty THEN pushrhs[t] ELSE pushlex[Lexeme[se[sei]]] ; 
IF s - wordlength THEN Cioutl[IF usePut THEN qPS ELSE qWS, v] ELSE 
IF s = 2*wordlength THEN Cioutl[IF usePut THEN qPSD ELSE qWSD, v] 
ELSE Ciout2[IF usePut THEN qPSF ELSE qWSF, v t FieldParam[r]] ; 
releaseBDOItem[r]; 
RETURN 
END; 

transferconstruct: PUBLIC PROCEDURE [r: BDOIndex, t: TreeLink, tsei: CSEIndex] - 
BEGIN -- subroutine for parameter/RETURN records built in memory 
savCS: ConstructionState; 

SaveConstructionState[@savCS]; 

DUPcount <- 0; Buil dinglnStack +• r ■ BDONull; 

TreeDef s . scanl ist[t , countDUPs]; 

IF DUPcount # THEN 

BEGIN 

AddressOnStack <- -BuildinglnStack; 

IF AddressOnStack THEN DUPcount «- DUPcount+1; 

mainconstruct[r , t, tsei, FnField]; 

IF DUPcount # (IF AddressOnStack THEN 1 ELSE 0) THEN SIGNAL ConstructionError ; 

END ELSE IF r § BDONull THEN releaseBDOItem[r ] ; 
RestoreConstructionState[@savCS]; 
RETURN 
END; 

fieldaddress: PROCEDURE [sei: ISEIndex] RETURNS [BitAddress, CARDINAL] - 
BEGIN 

RETURN [(seb+sei) . idvalue, (seb+sei) . idinfo] 
END; 

ma inconstruct : PROCEDURE [r: BDOIndex, maint: TreeLink, rsei: CSEIndex, 
fa: PROCEDURE[ISEIndex] RETURNS [BitAddress, CARDINAL]] - 
BEGIN -- workhorse subroutine for construction in memory 
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fieldsei: ISEIndex; 
temp: TreeLink; 
more: BOOLEAN 4- TRUE; 
savDC, pad: CARDINAL; 
constctx: CTXIndex; 
rcsei: recordCSEIndex; 
ssmc: PROCEDURE [root: TreeLink] - 
BEGIN 

rep: BitAddress; 
res: CARDINAL; 
copyr: BDOIndex «- BDONull; 
node: Treelndex; 
tsei: ISEIndex; 
tagvalue, fillsize: CARDINAL; 
iscontrolled: BOOLEAN ♦- FALSE; 
delta: CARDINAL 4- 0; 
nw, nb: CARDINAL; 
w: CARDINAL; 
bis: PROCEDURE » 
BEGIN 

lti: LitDefs.LTIndex; 
1: CARDINAL; 

mwconst: BOOLEAN «- FALSE; 
WITH root SELECT FROM 

subtree *> SELECT (tb+index) .name FROM 
mwconst a > 
BEGIN 

WITH (tb+index). sonl SELECT FROM 
literal -> WITH info SELECT FROM 
word s > lti «- index; 
ENDCASE => P5ADefs.P5Error[581]; 
ENDCASE ■> P5ADefs.P5Error[582]; 
WITH ll:(ltb+lti) SELECT FROM 
short B > push! itval[ll .value]; 
long -> FOR i IN [0 .. 1 1 . length) DO 
pushl itval[ll .value[i]]; 
ENDLOOP; 
ENDCASE; 
mwconst *- TRUE; 
END; 
ENDCASE; 
ENDCASE; 
IF -mwconst THEN pushrhs[root]; 
IF delta » THEN 
BEGIN 

[nw, nb] <- InlineDefs.DIVMOD[delta, wordlength]; 
IF nb # THEN SIGNAL CPtr . CodePassInconsistancy ; 
THROUGH [l..nw] DO pushl itval [0] ENDLOOP; 
END; 
RETURN 
END; 

BEGIN 

[rep, res] «- f a[f ieldsei]; 

WITH (seb+UnderType[(seb+fieldsei).idtype]) SELECT FROM 
union ■> 
BEGIN 

iscontrolled «- controlled; 
IF iscontrolled THEN 

BEGIN fieldsei <- tagsei; res <- (seb+f ieldsei) . idinfo END 
ELSE BEGIN fieldsei «- ISENull; res ^ END; 
END; 
ENDCASE; 
IF r # BDONull THEN 
BEGIN 

copyr «- copyBDOItem[r]; 
cb[copyr] .of f set. size ♦- res; 
cb[copyr] .off set .posn «- 

addfulladdrtobits[cb[copyr] .off set.posn, rep.wd * wordlength + rep.bd]; 
END; 
IF pad § THEN 
BEGIN 

cb[copyr] .of f set .size «- (res <- res+pad); 

cb[r] .off set. posn ♦- addful laddrtobits[cb[r].of f set .posn, pad]; 
pad <- 0; 
END; 



Store. mesa 2-Sep-78 12:59:59 Page 8 



IF root # empty THEN 
BEGIN 

WITH root SELECT FROM 
subtree ■> 

SELECT (tb+index). name FROM 
align ■> 
BEGIN 

root <- (tb+index) .sonl; -- note the variant may change here 
delta <- bitsfortype[(seb+f ieldsei) . idtype] - bitsforoperand[root] ; 
IF r # BDONull THEN 

res <- (cb[copyr], offset, size «- cb[copyr] .off set. size - delta); 
END; 
cast ■> root «- (tb+index) . sonl; 
ENDCASE; 
ENDCASE; 
WITH root SELECT FROM 
subtree a > 
BEGIN 

node <- index; 

IF (tb+node) .name a constructx 
AND TreeDefs.testtree[(tb+node) .sonl, temp] THEN 
BEGIN 

checkal ignment[copyr f TypeRoot[operandtype[root]] 
IBuildlnTemp »> 
BEGIN 

savDC *■ DUPcount; 
DUPcount <- 0; 

TreeDefs.scanl ist[( tb+node) .son2, countDUPs]; 
DUPcount *- savDC - DUPcount; 
bis[]; 
GOTO done 
END]; 
mainconstruct[copyr , (tb+node) .son2, operandtype[root] , fieldaddress 

IPutAddressOnStack ■> partialaddrtostack[copyr , WDdecr]]; 
GOTO done 
END; 
IF (tb+node) .name ■ unionx THEN 
BEGIN 

WITH (tb+node). sonl SELECT FROM 
symbol ■> tsei ♦- index; 
ENDCASE => P5ADefs.P5Error[583]; 
tagvalue <- (seb+tsei) . idvalue; 
more <~ TRUE; 
maint «- (tb+node) . son2; 

rcsei «- LOOPHOLE[UnderType[tsei] , recordCSEIndex]; 
constctx <- (seb+rcsei) . f ieldctx; 
fieldsei *- nextvar[(ctxb+constctx) . sel ist]; 
IF iscontrolled THEN 
BEGIN 

IF fieldsei # ISENull AND ( seb+f iel dsei ) . ctxnum # constctx THEN 
BEGIN -- a dummy fill field 
fillsize <- (seb+f ieldsei) . idinfo; 
tagvalue ♦- In! ineDef s .BITSHIFT[tagvalue t fillsize]; 
cb[copyr] .off set. size «- 

cb[copyr] .off set. si ze+f ill size; 
fieldsei +■ nextvar[NextSe[f ieldsei]]; 
END; 
Con s true tCoun tDown[ ] ; 

IF -AddressOnStack THEN P5ADef s ,P5Error[584]; 

CRassign[copyr, maketreel iteral[tagvalue] , ISENull, DUPcount#0]; 
END; 
RETURN 
END; 
IF (tb+node) .name a rowconsx AND ~BuildingInStack 
AND TreeDefs.testtree[(tb+node) .sonl, temp] THEN 
BEGIN 

Crow[copyr, node, UnderType[(seb+f ieldsei) . idtype]l 
GetFloorWD -> 
BEGIN 

[] <- loadaddress[copyBDOItem[copyr]]; 
w «- cb[copyr] .off set. posn .wd; 
addrtostack[copyr]; 
RESUME[w] 
END; 
PutAddressOnStack ■> partialaddrtostack[r, WDdecr]]; 
GOTO done 
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END; 
END; 
ENDCASE; 
ConstructCountDown[]; 

IF BuildinglnStack THEN BEGIN b1s[]; GOTO done END; 
IF AddressOnStack THEN CRassign[copyr, root, ISENull, DUPcounttfO] 
ELSE 
BEGIN 

mwc: BOOLEAN «- FALSE; 
1: Lexeme; 

1 «- Cexp[root t MWConstant *> BEGIN mwc <- TRUE; RESUME[[bdo[copyr]]] END]; 
IF mwc THEN releaseBDOItem[copyr] 

ELSE tllCassign[empty, [bdo[copyr]], 1, FALSE, res]; 
END; 
END 
ELSE 

IF BuildinglnStack THEN 

THROUGH [0. .(res+wordlength-l)/wordlength) DO push! itval[0] ENDLOOP; 
EXITS 

done -> NULL; 
END; 

fieldsei «- nextvar[NextSe[f ieldsei]] ; 
RETURN 
END; 

WITH (seb+rsei) SELECT FROM 
record ■> 
BEGIN 

rcsei <- LOOPHOLE[rsei , recordCSEIndex]; 
IF fa # FnField AND (seb+rcsei) . length < wordlength THEN 

pad <- cb[r] .of f set .size - ( seb+rcsei ). length 
ELSE pad <- 0; 

rcsei «- RecordRoot[rcsei]; 
constctx «- (seb+rcsei) .fieldctx; 
fieldsei <- nextvar[(ctxb+constctx) .sel 1st]; 
END; 
union => 
BEGIN 

pad *~ 0; temp <- TreeDef s. 1 isthead[maint]; 
WITH temp SELECT FROM 
subtree ■> 
BEGIN 

IF (tb+index) .name # unionx THEN P5ADef s . P5Error[585] ; 
WITH (tb+index). sonl SELECT FROM 

symbol ■> rsei «- UnderType[TypeLink[index]]; 
ENDCASE ■> P5ADefs.P5Error[586]; 
END; 
ENDCASE -> P5ADefs.P5Error[587]; 
WITH (seb+rsei) SELECT FROM 

record s > fieldsei <- ContextVariant[f ieldctx] ; 
ENDCASE -> P5ADefs.P5Error[588]; 
constctx <- (seb+f ieldsei ) .ctxnum; -- pass the first test 
END; 
ENDCASE => P5ADefs.P5Error[589]; 
WHILE more DO 
more ♦- FALSE; 

IF fieldsei # ISENull AND (seb+f ieldsei) .ctxnum # constctx THEN 
BEGIN 

DUPcount <- DUPcount+1; 
ssmc[maketreeliteral[0]]; 
END; 
TreeDefs. scanl ist[maint, ssmc]; 
ENDLOOP; 
IF -BuildinglnStack THEN releaseBDOItem[r]; 
RETURN 
END; 

Cconstructx: PUBLIC PROCEDURE [node: Treelndex] RETURNS [Lexeme] ■ 
BEGIN 

RETURN [sconstructx[node, FALSE]] 
END; 

Cvconstructx: PUBLIC PROCEDURE [node: Treelndex] RETURNS [Lexeme] * 
BEGIN 



Store. mesa 2-Sep-78 12:59:59 Page 10 



RETURN [sconstructx[node, TRUE]] 
END; 

sconstructx: PROCEDURE [node: Treelndex, variant: BOOLEAN] RETURNS [1: Lexeme] ■ 
BEGIN 

-- generate code for constructor expression 
r: BDOIndex; 
tsei: recordCSEIndex; 
wa: BOOLEAN <- FALSE; 
nodel: Treelndex; 
csei: CSEIndex; 
savCS: ConstructionState; 
nbits, w: CARDINAL; 
tl: TreeLink «- (tb+node) .sonl; 

SaveConstructionState[@savCS]; 
InitConstructSt ate [node]; 
IF variant THEN 

WITH tl SELECT FROM 

subtree a > tl <- (tb+index) . sonl; 
ENDCASE => P5ADefs.P5Error[590]; 
tsei «- LOOPHOLE[operandtype[tl], recordCSEIndex]; 
IF -variant THEN 
BEGIN 

wa «- wordal igned[LOOPHOLE[tsei , recordCSEIndex]]; 
WITH tl SELECT FROM 
subtree => 
BEGIN 

nodel «- index; 
IF (tb+nodel) .name - temp AND wa AND WordsForType[tsei] < a MaxParmsInStack THEN 

BuildinglnStack *- TRUE; 
END; 
ENDCASE; 
END; 
IF variant THEN 

WITH (tb+node). sonl SELECT FROM 
subtree ■> 

WITH (tb+index). son2 SELECT FROM 
symbol a > 

IF nextvar[(ctxb+(seb+RecordRoot[tsei]) .f ieldctx) .selist] * index THEN 

BEGIN csei <- tsei; variant <- FALSE END 
ELSE csei «- UnderType[(seb+index) . idtype] ; 
ENDCASE => P5ADefs.P5Error[591]; 
ENDCASE 
ELSE csei <- tsei; 
IF -BuildinglnStack THEN 
BEGIN 

r <- maketsonBDOItem[tl].lexbdoi ; 
IF ~wa OR ~easilyaddressed[r] THEN 
BEGIN 
IF loadaddress[copyBDOItem[r]] § wordlength THEN 

SIGNAL CPtr.CodeNotlmplemented; 
addrtostack[r]; 

IF variant AND (nbits <- bitsf oroperand[tl]) < wordlength THEN 
BEGIN 
cb[r].off set.posn *- 

addfulladdrtobits[cb[r] .off set .posn , cb[r] .of f set .size - nbits]; 
cb[r]. offset. size «- nbits; 
END; 
AddressOnStack <- TRUE; 
END; 
END; 
DUPcount <- DUPcount + 1; 

mainconstruct[IF -BuildinglnStack THEN copyBDOItem[r] ELSE BDONull, 
( tb+node) .son2 , csei, fieldaddress 
IPutAddressOnStack «> RESUME; 
GetFloorWD «> 
BEGIN 

[] <- loadaddress[copyBDOItem[r]]; 
w <- cb[r] .offset. posn. wd; 
addrtostack[r]; 
RESUME[w] 
END]; 
IF DUPcount # 1 THEN SIGNAL ConstructionError ; 
IF BuildinglnStack THEN 1 ♦- makeTOSlex[WordsForType[tsei]] ELSE 1 <- Lexeme[bdo[r]] ; 
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RestoreConstructionState[@savCS]; 

RETURN [1] 

END; 

wordaligned: PROCEDURE [tsei: recordCSEIndex] RETURNS [BOOLEAN] ■ 

BEGIN -- sees if a word-aligned record (never TRUE for a variant record) 
sei: ISEIndex; 
wa: INTEGER «- 0; 
a: BitAddress; 

tsei <- RecordRoot[tsei]; 

IF (seb+tsei). variant THEN RETURN[FALSE]; 

sei <- nextvar[(ctxb+(seb+tsei) .f ieldctx) .selist]; 

UNTIL sei - ISENull DO 

a <- (seb+sei) . idvalue; 

IF a.bd # THEN RETURN[FALSE]; 

IF a.wd < wa THEN RETURN [FALSE]; 

wa «- a.wd; 

sei <- nextvar[NextSe[sei]]; 

ENDLOOP; 
RETURN[TRUE] 
END; 

GetFloorWD: SIGNAL RETURNS [CARDINAL] ■ CODE; 
PutAddressOnStack: SIGNAL [WDdecr: CARDINAL] = CODE; 
BuildlnTemp: SIGNAL = CODE; 

checkal ignment: PROCEDURE [r: BDOIndex, rsei: CSEIndex] » 
BEGIN 
w: CARDINAL; 

IF AddressOnStack THEN RETURN; 

IF ~wordaligned[LOOPHOLE[UnderType[rsei], recordCSEIndex]] THEN 

BEGIN 

IF BuildinglnStack THEN SIGNAL BuildlnTemp; 

w 4- SIGNAL GetFloorWD; 

SIGNAL PutAddressOnStack[w]; 

partialaddrtostack[r , w]; 

AddressOnStack <- TRUE; 

END; 
RETURN 
END; 

easilyaddressed: PUBLIC PROCEDURE [r: BDOIndex] RETURNS [BOOLEAN] - 
BEGIN 

1 : ContextLevel ; 

IF cb[r].tag # o THEN RETURN [FALSE]; 
1 <- cb[r]. offset. level ; 
RETURN [1 = CPtr.curctxIvl OR 1 « 1G] 
END; 

addrtostack: PROCEDURE [r: BDOIndex] » 
BEGIN 

partial addrtostack[r , cb[r] .off set.posn .wd]; 
RETURN 
END; 

partialaddrtostack: PROCEDURE [r: BDOIndex, w: CARDINAL] « 
BEGIN 
psize: CARDINAL - IF cb[r].tag ■ bo THEN cb[r] . base . size 

ELSE wordlength; 
cb[r].base ♦- [level: 1TOS, posn: FuHBitAddress[G\ 0], size: psize]; 
cb[r].tag *- bo; 

cb[r] .off set. posn. wd *- cb[r]. offset. posn. wd - w; 
cb[r], off set. level ♦- 1Z; 
RETURN 
END; 

Cconstruct: PUBLIC PROCEDURE [node: Treelndex] « 
BEGIN 

sconstruct[node, FALSE]; 
RETURN 
END; 
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Cvconstruct: PUBLIC PROCEDURE [node: Treelndex] - 
BEGIN 

sconstruct[node, TRUE]; 
RETURN 
END; 

sconstruct: PROCEDURE [node: Treelndex, variant: BOOLEAN] ■ 
BEGIN -- generate code for construct statement 
tsei: recordCSEIndex; 
wa: BOOLEAN ♦- FALSE; 
r: BDOIndex; 
csei: CSEIndex; 
nbits, w: CARDINAL; 
tl: TreeLink *- (tb+node) .sonl; 

InitConstructSt ate [node]; 
IF DUPcount » THEN RETURN; 
IF variant THEN 

WITH tl SELECT FROM 

subtree ■> tl «- (tb+index) . sonl; 
ENDCASE -> P5ADefs.P5Error[592]; 
tsei <- LOOPHOLE[operandtype[tl], recordCSEIndex]; 
IF -variant THEN wa <- wordal igned[LOOPHOLE[tsei , recordCSEIndex]]; 
IF variant THEN 

WITH (tb+node). sonl SELECT FROM 
subtree *> 

WITH (tb+index). son2 SELECT FROM 
symbol »> 

IF nextvar[(ctxb+(seb+RecordRoot[tsei]) .f ieldctx) .sel ist] * index THEN 

BEGIN csei <- tsei; variant «- FALSE END 
ELSE csei <- UnderType[(seb+index) . idtype]; 
ENDCASE = > P5ADefs.P5Error[593]; 
ENDCASE 
ELSE csei «- tsei; 
r <- maketsonBDOItem[tl]. lexbdoi ; 
IF -wa OR cb[r].tag # o THEN 
BEGIN 
IF loadaddress[copyBDOItem[r]] # wordlength THEN 

SIGNAL CPtr.CodeNotlmplemented; 
addrtostack[r] ; 

IF variant AND (nbits <- bitsforoperand[tl]) < wordlength THEN 
BEGIN 
cb[r]. offset. posn *- 

addfulladdrtobits[cb[r]. offset. posn, cb[r] .of fset. size - nbits]; 
cb[r].off set. size <~ nbits; 
END; 
AddressOnStack ♦- TRUE; 
END; 
mainconstruct[r , ( tb+node) . son2, csei, fieldaddress 
IPutAddressOnStack => RESUME; 
GetFloorWD ■> 
BEGIN 

[] <- 1oadaddress[copyBD0Item[r]]; 
w ♦• cb[r] .off set. posn. wd; 
addrtostack[r]; 
RESUME[w] 
END]; 
IF DUPcount n THEN SIGNAL ConstructionError ; 
RETURN 
END; 

Cextract: PUBLIC PROCEDURE [node: Treelndex] - 
BEGIN 

tsei: recordCSEIndex <- LOOPHOLE[operandtype[( tb+node) . sonl] , recordCSEIndex]; 
fa: PROCEDURE[ISEIndex], RETURNS [BitAddress, CARDINAL] <- 

IF (seb+tsei ) .argument THEN FnField ELSE f iel daddress; 
startsei: ISEIndex *- (ctxb+(seb+tsei) .f ieldctx) .sel ist; 
sei: ISEIndex <- startsei; 
isei: ISEIndex *- startsei; 
soncount: CARDINAL *■ 0; 
r: BDOIndex; 

transferrec, instk, ExAddressOnStack, addrintemp, wa: BOOLEAN «- FALSE; 
tlex: se Lexeme; 



Store. mesa 2-Sep-78 12:59:59 Page 13 



psize: CARDINAL; 

xcount: PROCEDURE [t: TreeLink] - 
BEGIN 

IF t # empty THEN 
BEGIN 

soncount *- soncount+1; 
WITH t SELECT FROM 

subtree «> IF wordsforoperand[(tb+index) .sonl] > 2 THEN 

addrintemp «- TRUE; 
ENDCASE; 
END; 
RETURN 
END; 
sextract: PROCEDURE [t: TreeLink] ■ 
BEGIN 

rep: BitAddress; 
res: CARDINAL; 
rr: BDOIndex; 

[rep, res] <- fa[sei]; 
IF t# empty THEN 

BEGIN 

soncount <- soncount-1; 

IF addrintemp THEN pushlex[tlex] 

ELSE IF transferrec OR (ExAddressOnStack AND soncount > 0) THEN 
Ciout0[FOpCodes.qDUP]; 

CPtr.xtractlex «- Lexeme[bdo[rr <- copyBDOItem[r]]]; 

CPtr.xtractsei *- sei ; 

IF instk THEN cb[rr] .of f set .posn <- Ful lBitAddress[0, 0] 

ELSE cb[rr] .offset .posn <- addf ulladdrtobi ts[cb[rr] .of f set . posn , rep ,wd*wordlength+rep .bd] ; 

cb[rr] .off set. size «- res; 

WITH t SELECT FROM 

subtree B > Cassign[index]; 
ENDCASE => P5ADefs.P5Error[594]; 

END 
ELSE IF instk THEN THROUGH [1 . . res/wordlength] DO CioutO[FOpCodes .qPOP] ENDLOOP; 
sei ♦• prevvar[startsei , sei]; 
RETURN 
END; -- of sextract 

IF (seb+tsei) .argument THEN fa «- FnField 
ELSE fa «- f ieldaddress; 

UNTIL (isei «- NextSe[sei]) « ISENull DO 
isei <- nextvar[isei]; 
IF isei - ISENull THEN EXIT; 
sei «- isei; 
ENDLOOP; 
r <~ maketsonBDOItem[(tb+node) .son2 
ILogHeapFree a > 

IF calltree = ( tb+node) . son2 THEN 

BEGIN transferrec «- TRUE; RESUME[TRUE, topostack] END; 
MWConstant ■> SIGNAL CPtr .CodeNotlmplemented] . lexbdoi ; 
instk «- cb[r].tag ■ o AND cb[r].off set. level - 1TOS; 
IF fa ft FnField AND cb[r] .of f set . size > bitsf ortype[tsei] THEN 
BEGIN -- padding in record, value shifted to the right 
cb[r] .off set. posn «- addfulladdrtobits[cb[r] .of fset.posn, 

cb[r], offset. size - bitsfortype[tsei]]; 
END; 
wa «- wordal igned[LOOPHOLE[operandtype[(tb+node) .son2], recordCSEIndex]] ; 
TreeDef s. scan! is t[( tb+node ). sonl, xcount]; 
IF addrintemp AND instk AND wa THEN addrintemp ♦■ FALSE; 
IF addrintemp OR 

(fa # FnField AND (-wa OR (-instk AND ~easilyaddressed[r])) ) THEN 
BEGIN 

psize <- loadaddress[copyBDOItem[r]]; 
IF psize > wordlength THEN addrintemp ♦- TRUE; 
cb[r] .base, size <- psize; 
addrtostack[r]; 
IF addrintemp THEN 
BEGIN 

tlex 4- gentemplex[psize/wordlength]; 
sCassign[tlex.lexsei]; 
END 
ELSE ExAddressOnStack «- TRUE; 
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instk ♦• FALSE; 

END; 
IF soncount ■ THEN 

BEGIN 

releaseBDOItem[r]; 

IF transferrec THEN 
BEGIN 

IF addrintemp THEN pushlex[tlex]; 
CioutO[FOpCodes.qFREE]; 
END; 

UNTIL CPtr.acstack - DO CioutO[FOpCodes .qPOP] ENDLOOP; 

RETURN 

END; 
CPtr.xtracting «- TRUE; 

TreeDefs.reversescanl ist[(tb+node) .sonl, sextract]; 
releaseBDOItem[r]; 
IF transferrec THEN 

BEGIN 

IF addrintemp THEN pushlex[tlex] ; 

CioutO[FOpCodes.qFREE]; 

END; 
UNTIL CPtr.acstack - DO CioutO[FOpCodes.qPOP] ENDLOOP; 
CPtr.xtracting ♦- FALSE; 
RETURN 
END; 



sCassign: PUBLIC PROCEDURE [sei: ISEIndex] « 

BEGIN -- assigns to a simple variable from the stack 

Cstore[rmakeBDOItem[Lexeme[se[sei]]]] ; 

RETURN 

END; 



Cassign: PUBLIC PROCEDURE [node: Treelndex] » 
BEGIN -- generates code for assignment statement 
IF (tb+node).attrl THEN 

BEGIN SIGNAL CPtr . CodeNotlmplemented ; RETURN END; 
comassign[(tb+node) .sonl, ( tb+node) . son2, FALSE]; 
RETURN 
END; 



ValsOnStack: SIGNAL » CODE; 

AddrOnStack: SIGNAL [addrsize: CARDINAL] - CODE; 

Cassignx: PUBLIC PROCEDURE [node: Treelndex] RETURNS [Lexeme] - 
BEGIN -- generates code for assignment expression 
OPEN CPtr; 
nwords: CARDINAL; 
push: BOOLEAN «- TRUE; 
valshere: BOOLEAN «- FALSE; 
psize: CARDINAL <- wordlength; 

IF ( tb+node). attrl THEN ERROR CPtr. CodeNotlmplemented; 
nwords <- wordsforoperand[( tb+node) , sonl]; 
comassign[(tb+node) .sonl, ( tb+node) . son2, TRUE 
JAddrOnStack ■> 

BEGIN push «- FALSE; psize *- addrsize; RESUME END; 
ValsOnStack • > BEGIN valshere <- TRUE; RESUME END]; 
IF -valshere THEN 
BEGIN 

IF push THEN CioutO[FOpCodes.qPUSH]; 
IF nwords - 2 THEN CioutO[FOpCodes . qPUSH] ; 
END; 
RETURN[mak ere t lex [nwords, psize]] ; 
END; 



comassign: PROCEDURE [tl,t2: TreeLink, isexp: BOOLEAN] 
BEGIN 

nbits: CARDINAL; 
node: Treelndex; 
leftr, rightr: BDOIndex; 
right! : Lexeme; 
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leftl : bdo Lexeme; 
psize: CARDINAL; 
mwconst: BOOLEAN +• FALSE; 

diddleleft: PROCEDURE - 
BEGIN 

leftl <- makeBDOItem[Cexp[(tb+node).sonl]]; 
leftr «- leftl. lexbdoi; 
cb[leftr]. offset. size <- 

cb[leftr] .offset. size - (bitsforoperand[(tb+node) .sonl] - nbits); 
END; 

WITH tl SELECT FROM 
subtree ■> 
BEGIN 

node +■ index; 

IF (tb+node) .name ■ align THEN 
BEGIN 

nbits <- bitsforoperand[t2]; 
IF nbits <- wordlength*2 THEN 
BEGIN 

pushrhs[t2]; 

rightr <- rmakeBDOItem[makeTOSlex[(nbits+wordlength-l)/2]]; 
END 
ELSE 
BEGIN 

right! «- Cexp[t2 
IMWConstant »> 
BEGIN 

mwconst «- TRUE; 
diddleleft[]; 
RESUMEpeftl]; 
END]; 
IF mwconst THEN 
BEGIN 
IF isexp THEN 

BEGIN psize <- loadlexaddress[lef tl]; 
SIGNAL AddrOnStack[psize]; 
END 
ELSE ReleaseLex[leftl]; 
RETURN; 
END; 
rightr *- rmakeBDOItem[rightl ]; 
psize <- loadaddress[copyBDOItem[rightr]]; 
cb[rightr]. base. size «- psize; 
add r to s tack [ rightr]; 
END; 
diddleleft[]; 

tl!Cassign[empty , leftl, [bdo[rightr]] , isexp, nbits]; 
RETURN 
END; 
END; 
ENDCASE; 
nbits «- bitsforoperand[tl]; 
IF t2 U empty THEN WITH t2 SELECT FROM 
subtree -> 
BEGIN 

node «- index; 

SELECT (tb+node). name FROM 
cast a > t2 <~ (tb+node) .sonl; 
ENDCASE; 
END; 
ENDCASE; 
IF t2 # empty THEN WITH t2 SELECT FROM 
subtree «> 
BEGIN 

node «- index; 

SELECT (tb+node). name FROM 
align ■> 
BEGIN 

rightr <- rmakeBDOItem[Cexp[( tb+node) . sonl 
IMWConstant «> 
RESUME[gentemplex[ (nbits+wordlength-1)/ wordlength]]]] ; 
psize «- loadaddress[copyBDOItem[rightr]]; 
cb[rightr] .base, size «- psize; 
addrtostack[ rightr]; 
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cb[rightr]. offset. size <- 

cb[rightr]. offset . size - (bitsforoperand[(tb+node) .sonl] - nbits); 
tllCassign[tl, topostack, [bdo[rightr]] , isexp, nbits]; 
RETURN 
END; 
mwconst a > 
BEGIN 

right! ♦- Cexp[t2 IMWConstant ■> GO TO mwconst]; 
tllCassign[tl, topostack, right!, isexp, nbits]; 
RETURN; 
EXITS mwconst ■> 

BEGIN CassignMwconst[tl, t2, isexp]; RETURN END; 
END; 
ENDCASE; 
END; 
ENDCASE; 
tl!Cassign[tl, topostack, Cexp[t2], isexp, nbits]; 
RETURN 
END; 

ComplicatedAddr: PROCEDURE [node: Treelndex] RETURNS [BOOLEAN] - 
BEGIN -- TRUE if arithmetic needed to generate address of t 
— FALSE e.g. if t ■ pt 

IF (tb+node).name # uparrow THEN RETURN[TRUE] ; 
WITH (tb+node).sonl SELECT FROM 

symbol ■> RETURN[FALSE]; 

ENDCASE -> RETURN[TRUE]; 
END; 

CassignMwconst: PROCEDURE [tl, t2: TreeLink, isexp: BOOLEAN] » 
BEGIN OPEN FOpCodes; -- t2 is mwconst of length > 2 
psize: CARDINAL; 
destaddrlex: se Lexeme; 
destlex: Lexeme; 
BEGIN 

WITH tl SELECT FROM 
subtree «> 

IF ComplicatedAddr[index] THEN 
BEGIN 

psize <- loadtsonaddress[tl] ; 
destaddrlex *- gentemplex[psize/wordlength]; 
sCassign[ destaddrlex. lexsei]; 

destlex <- [bdo[maketempaddrBDOItem[destaddrlex]]]; 
GO TO compl icated; 
END; 
ENDCASE; 
destlex <- Cexp[tl]; 
EXITS complicated ■> NULL; 
END; 

destlex <~ Cexp[t2 IMWConstant -> RESUME[destlex]]; 
IF isexp THEN 
BEGIN 

psize *- loadlexaddress[destlex]; 
SIGNAL AddrOnStack[psize]; 
END 
ELSE ReleaseLex[destlex]; 
END; 

ReleaseLex: PR0CEDURE[1: Lexeme] ■ 
BEGIN 
WITH 1 SELECT FROM 

bdo ■> releaseBDOItem[lexbdoi]; 

ENDCASE; 
RETURN 
END; 

Cregstore: PROCEDURE[v: RegisterName] ■ 
BEGIN 

SELECT v FROM 
< 100B -> 

BEGIN Cioutl[FOpCodes.qWR, v] END; 
ENDCASE «> SIGNAL CPtr .CodeNotlmplemented; 
RETURN 
END; 
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tllCassign: PROCEDURE [leftson: TreeLink, leftlex, 1: Lexeme, exp: BOOLEAN, nbits: CARDINAL] - 
BEGIN -- main subroutine for doing assignment statements and expressions 
OPEN FOpCodes; 
tlex: se Lexeme; 
r: BDOIndex; 

nwords: CARDINAL <- (nbits+wordlength-l)/wordl ength ; 
v, ss, psize, dsize: CARDINAL; 

IF nwords « 1 THEN 
BEGIN 

pushlex[l]; 

IF leftson # empty THEN leftlex <- Cexp[lef tson]; 
WITH e: leftlex SELECT FROM 
other -> WITH e SELECT FROM 
byte ■> 
BEGIN 

Cioutl[(IF long THEN qWSTRL ELSE qWSTR), lexalpha]; 
RETURN 
END; 
register »> Cregstore[lexrn]; 
ENDCASE; 
ENDCASE ■> Cstore[rmakeBDOItem[leftlex]]; 
RETURN 
END; 
WITH 1 SELECT FROM 
bdo «> 
BEGIN 

r <- lexbdoi ; 

IF cb[r].tag » o AND cb[r] .of f set . level = 1T0S THEN 
BEGIN 

ss «- cb[r].off set.posn.wd; 
cb[r].off set.posn. wd «- 0; 
Cload[r]; 
r <- IF leftson - empty THEN rmakeBDOItem[lef tlex] 

ELSE maketsonBDOItem[lef tson] . lexbdoi; 
IF -exp OR (nwords <=» 2 AND ss = 0) THEN 
BEGIN 
CstoreTrT * 

THROUGH [l..ss] DO CioutO[qPOP] ENDLOOP; 
RETURN 
END; 
psize *- loadaddress[r]; 
tlex <- gentemplex[psize/wordlength]; 
sCassign[tlex. lexsei]; 
v <- nwords; 
THROUGH [1..V/2] DO 

pushlex[tlex]; v «- v-2; 

Cioutl[IF psize > wordlength THEN qWDL ELSE qWD, v]; 
ENDLOOP; 
IF v # THEN 
BEGIN 

pushlex[tlex]; 

Cioutl[IF psize > wordlength THEN qWL ELSE qW, v-1]; 
END; 
THROUGH [l..ss] DO CioutO[qPOP] ENDLOOP; 
IF exp THEN 

IF nwords > 2 THEN 
BEGIN 

pushlex[tlex]; 
SIGNAL AddrOnStack[psize]; 
END 
ELSE 

BEGIN 

pushlex[tlex]; 

Cioutl[IF psize > wordlength THEN qRDL ELSE qRD, 0]; 
SIGNAL ValsOnStack; 
END; 
RETURN 
END 
END; 
ENDCASE; 
IF nwords > 2 THEN 
BEGIN 

psize <- loadaddress[rmakeBDOItem[l]] ; 
Requ i reSt ack[psize/word length]; 
IF exp THEN 
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BEGIN 

tlex <- gentemplex[psize/wordlength]; 
sCassign[tlex.lexsei]; 
C1outO[qPUSH]; 

IF psize > wordlength THEN CioutO[qPUSH] ; 
END; 
IF psize » wordlength AND 

(IF leftson - empty THEN LongLexAddress[lef tlex] 
ELSE LongTreeAddress[leftson]) THEN CioutO[qLP]; 
push! itval[nwords]; 

dsize <- loadlexaddress[IF leftson ■ empty THEN leftlex ELSE Cexp[lef tson]]; 
IF psize > dsize THEN BEGIN CioutO[qLP]; dsize +* psize END; 
CioutO[IF dsize > wordlength THEN qBLTL ELSE qBLT]; 
IF exp THEN BEGIN pushlex[tlex] ; SIGNAL AddrOnStack[psize] ; END; 
RETURN 
END; 
Cload[rmakeBDOItem[l]]; 

Cstore[IF leftson ■ empty THEN rmakeBDOItempef tlex] ELSE maketsonBDOItem[lef tson]. lexbdoi]; 
RETURN 
END; 

LongTreeAddress: PUBLIC PROCEDURE [t: TreeLink] RETURNS [long: BOOLEAN] « 
BEGIN 

node: Treelndex; 
WITH t SELECT FROM 
subtree ■> 

BEGIN node <- index; 
IF node s TreeDefs .nullTreelndex 
THEN long «- FALSE 
ELSE SELECT ( tb+node) . name FROM 
loophole, cast, openexp, align ■> 

long *- LongTreeAddress[(tb+node) .sonl]; 
dot, uparrow, dindex, seqindex, dollar, index, reloc *> 

long <- (tb+node) .attrl; 
assignx => WITH (tb+node) .son2 SELECT FROM 
subtree => IF (tb+index) . name ■ mwconst THEN 
long «- LongTreeAddress[(tb+node) .sonl] 
ELSE long «- LongTreeAddress[(tb+node) . son2]; 
ENDCASE => long «- LongTreeAddress[( tb+node) . son2]; 
ENDCASE = > long + FALSE; 
END; 
ENDCASE ■> long 4- FALSE; 
RETURN 
END; 

LongLexAddress: PUBLIC PROCEDURE [1: Lexeme] RETURNS [long: BOOLEAN] - 
BEGIN 

WITH 1 SELECT FROM 
bdo ■> 

SELECT cb[lexbdoi].tag FROM 
o ■> long <- FALSE; 

bo s > long <- cb[lexbdoi] .base, size > wordlength; 
ENDCASE »> 

long «- cb[lexbdoi] .base, size > wordlength OR 
cb[lexbdoi] .disp.size > wordlength; 
ENDCASE -> long «- FALSE; 
RETURN 
END; 

slCassign: PUBLIC PROCEDURE [sei: ISEIndex, 1: Lexeme, exp: BOOLEAN, nwords: CARDINAL] - 
BEGIN -- sei-lexeme interface to tllCassign 

tl lCassign[empty , Lexeme[se[sei]] , 1, exp, nwords*wordlength]; 
RETURN 
END; 

Cportinit: PUBLIC PROCEDURE [node: Treelndex] RETURNS [Lexeme] - 
BEGIN 

Cioutl[FOpCodes.qLI, 0]; 
Cioutl[FOpCodes.qLI, 0]; 
RETURN[makeTOSlex[2]] 
END; 
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Cbodyinit: PUBLIC PROCEDURE [node: Treelndex] RETURNS [se Lexeme] 
BEGIN -- assigns proc. desc for proc. variable 
bti: CBTIndex ♦■ (tb+node) . info; 

WITH (bb+bti).info SELECT FROM 

Internal »> CPtr.f ileindex «- sourcelndex; 

ENDCASE; 
pushlprocdesc[bti]; 
RETURN [topostack] 
END; 



Cstringinit: PUBLIC PROCEDURE [node: Treelndex] RETURNS [se Lexeme] 
BEGIN -- inits string storage and pushes pointer on stack 
nchars: CARDINAL; 
1 : se Lexeme; 

nchars <- treel iteralvalue[(tb+node) .son2]; 

1 «- genstringbodylex[nchars]; 

[] «- loadlexaddress[l] ; 

freetempsei[l .lexsei]; 

push! itval[0]; 

push! itval [nchars]; 

Cioutl[FOpCodes.qPSD, 0]; 

RETURN [topostack] 

END; 



Cprocinit: PUBLIC PROCEDURE [node: Treelndex] 
BEGIN 
bti: CBTIndex <- (tb+node) . info; 

WITH (bb+bti) SELECT FROM 
Inner »> 
BEGIN 

pushlnonnestedprocdesc[entryIndex]; 
Cioutl[FOpCodes.qSL, f rameOff set]; 
END; 
ENDCASE; 
RETURN 
END; 

END... 



